/* Definitions for the coroutine type.

   This file is part of khipu.

   khipu is free software: you can redistribute it and/or modify
   it under the terms of the GNU Lesser General Public License as published by
   the Free Software Foundation; either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public License
   along with this program.  If not, see <https://www.gnu.org/licenses/>.  */

#include <cstdio>
#include "khipu.hpp"

KP_DECLS_BEGIN

static object
make_argv (interpreter *interp, uint32_t bp, coroutine *outp)
{
  uint32_t max_sp = as_fct(interp->stack[bp - 1])->max_sp;
  uint32_t nsp = interp->stklen () - (bp - 1);
  array *ap = as_array (alloc_array (interp, nsp + max_sp));
  copy_objs (ap->data, &interp->stack[bp - 1], nsp);

  uint32_t nargs = as_int (interp->stack[interp->cur_frame - 3]);
  uint32_t start = interp->cur_frame - nargs - interpreter::frame_size - 1;
  outp->frame = interpreter::frame_size + 1 + nargs;
  ap->data[outp->frame - 4] = fixint (0);

  if (interp->exc_offset <= start)
    outp->exc_off = 0;
  else
    { // Adjust exception handler offsets.
      for (uint32_t eoff = interp->exc_offset ; ; )
        {
          uint32_t ipos = eoff - start;
          uint32_t prev = as_int (interp->stack[eoff]);

          if (prev < start)
            {
              ap->data[ipos] = fixint (0);
              break;
            }

          ap->data[ipos] = fixint (prev - start);
          eoff = prev;
        }

      outp->exc_off = interp->exc_offset - start;
    }

  return (ap->as_obj ());
}

struct coro_state : call_guard
{
  valref stkobj;
  uint32_t saved_objlen;

  coro_state (interpreter *ip) : call_guard (ip),
      stkobj (ip, ip->stkobj), saved_objlen (len_a (ip->stkobj))
    { // Make sure the GC doesn't scan past the interpreter's stack end.
      as_array(ip->stkobj)->len = this->sp;
    }

  ~coro_state ()
    {
      as_array(*this->stkobj)->len = saved_objlen;
      this->interp->stkobj = *this->stkobj;
      this->interp->stack = &xaref(*this->stkobj, 0);
    }
};

object coro_next (interpreter *interp, object *argv, int argc)
{
  auto crp = as<coroutine> (*argv);
  if (!crp)
    interp->raise ("type-error", "argument must be a coroutine");
  else if (!crp->valid_p ())
    interp->raise ("arg-error", "coroutine exhausted");

  coro_state state (interp);
  object value = argc == 2 ? argv[1] : crp->value;

  try
    {
      interp->stkobj = crp->argv;
      interp->stack = &xaref(interp->stkobj, 0);
      interp->stkend = interp->stack + crp->frame + crp->sp_diff;
      interp->cur_frame = 0;
      interp->exc_offset = crp->exc_off;

      if (kp_unlikely (array_p (crp->dbinds)))
        // There are dynamic variables to rebind.
        for (uint32_t i = 0; i < len_a (crp->dbinds); i += 2)
          interp->tl_syms[symtlidx (xaref (crp->dbinds, i)) - 1] =
            xaref (crp->dbinds, i + 1);

      object ret = call_coroutine (interp, crp, value);
      if (!coro_p (ret))
        {
          crp->mark_invalid ();
          kp_return (NIL);
        }

      kp_return (ret);
    }
  catch (exception&)
    { // Generate the stacktrace from the coroutine and rethrow.
      interp->stacktrace (interp->cur_frame);
      throw;
    }
}

coroutine* coroutine::alloc_raw ()
{
  coroutine *ret = alloch<coroutine> ();
  ret->value = ret->argv = ret->dbinds = NIL;
  ret->frame = 0u;
  ret->ip_offset = ret->sp_diff = 0;
  return (ret);
}

object alloc_coroutine (interpreter *interp)
{
  auto ret = coroutine::alloc_raw ();
  interp->alval = ret->as_obj ();
  gc_register (interp, ret);
  return (interp->alval);
}

object coroutine::make (interpreter *interp, uint32_t bp)
{
  evh_guard eg (interp);
  coroutine *ret = coroutine::alloc_raw ();
  ret->value = UNBOUND;

  ret->argv = make_argv (interp, bp, ret);
  interp->alval = ret->as_obj ();
  gc_register (interp, ret);
  return (interp->alval);
}

int pack_G (interpreter *interp, stream *strm,
  object obj, pack_info& info)
{
  coroutine *crp = as_coro (obj);
  return (strm->write (interp, &crp->ip_offset) +
    strm->write (interp, &crp->sp_diff) +
    strm->write (interp, &crp->exc_off) +
    strm->write (interp, &crp->frame) +
    xpack (interp, strm, crp->value, info) +
    xpack (interp, strm, crp->argv, info));
}

object unpack_G (interpreter *interp, stream *strm, pack_info& info, bool save)
{
  valref ret (interp, alloc_coroutine (interp));
  coroutine *crp = as_coro (*ret);
  info.add_mapping (interp, *info.offset, *ret);

  if (!strm->sread (interp, &crp->ip_offset) ||
      !strm->sread (interp, &crp->sp_diff) ||
      !strm->sread (interp, &crp->exc_off) ||
      !strm->sread (interp, &crp->frame) ||
      (crp->value = xunpack (interp, strm, info)) == UNBOUND ||
      !array_p (crp->argv = xunpack (interp, strm, info)))
    kp_return (UNBOUND);

  if (save)
    info.add_mapping (interp, *info.offset, *ret);

  kp_return (*ret);
}

KP_DECLS_END
